﻿Option Explicit

'Call LoadFrameworkResource()
Call SartTestProject()

Function SartTestProject()
		Dim objtestProject,TestScriptObject
		Set objtestProject = New TestProject                                               
		objtestProject.StartTestProject
		Set objtestProject = nothing
		Set TestScriptObject = nothing
End Function

Function LoadFrameworkResource()
	ExecuteFile Environment.Value("FrameworkDir")&"log.vbs"
End Function


'=============================================================================================
'TestProject Class 
'============================================================================================== 
Class TestProject   

Private strProjectDir   
Private strFrameworkDir
Private strTestDataFolder
Private strTestScriptFolder
Private strTestSetExcelFile
Private strConfigFile
Private strAppFolder

'log properties
Private strLogDir
Private numPass
Private numFailed
Private bResult

Public Function StartTestProject () 


	InitialTestProject()
	StartTestProjectLog()

	Dim objTestSet
    Set objTestSet = new TestSet
	objTestSet.StartTestSet strTestSetExcelFile

	EndTestProjectLog()

End Function

Private Function  StartTestProjectLog()
		Dim fso, ofile
		Set fso = CreateObject("Scripting.FileSystemObject")
		If  fso.fileexists(Environment("LogDir")&"\runtime.xml")  Then
			fso.deletefile Environment("LogDir")&"\runtime.xml" 
		End If
		xmlLogPrint "<?xml version=""1.0"" encoding=""GB2312""?>"
		xmlLogPrint "<Project>"
End Function

Private Function EndTestProjectLog()
		 xmlLogPrint "<TotalResult>"&"Passed:"& Environment("numPassed")&", Failed:"&Environment("numFailed")
		 xmlLogPrint "</TotalResult>"
		 xmlLogPrint "</Project>"
End Function

Private Function InitialTestProject()
		strConfigFile = "config.xml"
		strTestSetExcelFile = "testSet.xls"

		Dim fso, tempFileName
		Set fso = CreateObject("Scripting.FileSystemObject")
		strProjectDir = fso.getparentfoldername(Environment.Value("TestDir"))
		Set fso = nothing
        strConfigFile = strProjectDir & "\" & strConfigFile
		tempFileName = Environment.ExternalFileName 
		If (tempFileName = "") Then 
			   Environment.LoadFromFile(strConfigFile) ' Get  Environment Value from config.xml file
		End If	

		strFrameworkDir = strProjectDir & "\" & Environment.Value("frameworkDir")
		strTestSetExcelFile = strProjectDir & "\" & Environment.Value("testSetExcelFile")
		strTestScriptFolder = strProjectDir & "\" & Environment.Value("testScriptFolderName")
		strTestDataFolder = strProjectDir & "\" & Environment.Value("testDataFolderName")
		strLogDir = strProjectDir&"\" & Environment.Value("logDir")
		strAppFolder = strProjectDir&"\" & Environment.Value("appFolder")
		numPass = 0
		numFailed = 0
		bResult = "Pass"

		 Environment("ProjectDir")  = strProjectDir
		 Environment("FrameworkFolder")  = strFrameworkDir
		 Environment("TestSetExcelFile")  = strTestSetExcelFile
		 Environment("TestScriptFolder")  = strTestScriptFolder
		 Environment("TestDataFolder")  = strTestDataFolder
		 Environment("LogDir")  = strLogDir
		 Environment("AppFolder")  = strAppFolder
		 Environment("numPassed")  = 0
		 Environment("numFailed")  = 0
		 Environment("bResult")  = bResult

End Function
End Class

'=============================================================================================
'TestSet Class
'=============================================================================================
Class TestSet

Private  TestCaseArrays


' package 'testSet.xls' to TestSet Class
Private Function InitialTestSet(TestSetExcelFile)
		 Dim strTestCaseIDX,strTestCaseName,strTestCaseTabe,strTestCaseSheet, strTestCasePriority, strTestCaseDescription 'relfect to 'name,table,sheet' in TestCases sheet of testSet.xls 
   		 Dim strTestSetInDataTable, strTestSetExcelFile
		 Dim intRowCount, i
		 Dim TestCaseArray(5)
         Set TestCaseArrays = CreateObject("Scripting.Dictionary")
         strTestSetExcelFile = TestSetExcelFile
         strTestSetInDataTable = "TestSet"
         DataTable.AddSheet(strTestSetInDataTable)
		 Err.Clear
		 On Error Resume Next
         DataTable.ImportSheet strTestSetExcelFile,1, strTestSetInDataTable 'import excel file may cause error , so use On Error Resume Next
	     If  err.number = 0  Then
			intRowCount = DataTable.GetSheet(strTestSetInDataTable).GetRowCount
			For i = 1 To intRowCount
				DataTable.GetSheet(strTestSetInDataTable).SetCurrentRow(i)
				strTestCaseIDX = DataTable.Value("IDX", strTestSetInDataTable) 
				If strTestCaseIDX = "√"  Then  
					'strTestCaseIDX = DataTable.Value("IDX", strTestSetInDataTable)   'test case sheet
					strTestCaseName = DataTable.Value("name", strTestSetInDataTable)  'test case name
					strTestCaseTabe = DataTable.Value("table", strTestSetInDataTable)     'test case table 
					strTestCaseSheet = DataTable.Value("sheet", strTestSetInDataTable)   'test case sheet
					strTestCasePriority = DataTable.Value("priority", strTestSetInDataTable)   'test case sheet
					strTestCaseDescription = DataTable.Value("description", strTestSetInDataTable)   'test case sheet
				   TestCaseArray(0)= strTestCaseIDX
				   TestCaseArray(1)= strTestCaseName
				   TestCaseArray(2)= strTestCaseTabe
				   TestCaseArray(3)= strTestCaseSheet
				   TestCaseArray(4)= strTestCasePriority
				   TestCaseArray(5)= strTestCaseDescription
				
				   If  err.number = 0 Then
					   TestCaseArrays.Add strTestCaseName, TestCaseArray
				   else
						Msgbox  "Check 'IDX, name, table, sheet' Column in 'testSet.xls'."&"--Error Code: "&err.number
				   End If                                 
				End If
				err.clear  	
			Next
		else  
		     Msgbox  "Check if 'testSet.xls' is opened, if it is opened, please close it " &"--Error Code: "&err.number
		End If
		DataTable.DeleteSheet  "TestSet"
		On Error Goto 0
End Function       

Public Function StartTestSet(TestSetExcelFile)

		InitialTestSet(TestSetExcelFile) 															'inistal test set
		StartTestSetLog()
		
		Dim TestCaseArray,TempTestCaseArrays
		Dim objTestCase
		Dim i
		TempTestCaseArrays = TestCaseArrays.Items
         For i =0 To TestCaseArrays.Count -1                           'execute each test case in test set
             TestCaseArray = TempTestCaseArrays(i)
			 Set objTestCase = new TestCase
             objTestCase.StartTestCase(TestCaseArray)       
        Next

		EndTestSetLog()
		

End Function 

Private Function StartTestSetLog()
		 xmlLogPrint "<TestSet>"
End Function

Private Function EndTestSetLog()
		xmlLogPrint  "</TestSet>"
End Function

End Class

'=============================================================================================
'TestCase Class
'============================================================================================== 
Class TestCase

Private strTestCaseIDx 'IDX
Private strTestCaseName 'name
Private	strTestCaseTable 'table
Private strTestCaseSheet ' sheet
Private strTestCasePriority ' priority
Private strTestCaseDescription ' description
Private TestStepArrays

' package 'testcasename.xls' to TestCase Class
 Private  Function InitialTestCase(TestCaseArray)
				  Dim strTestDataFolder, strTestCaseInDataTable, strTestCaseTablePath
                  strTestCaseIDX = TestCaseArray(0)
                  strTestCaseName = TestCaseArray(1)
                  strTestCaseTable = TestCaseArray(2)
				  strTestCaseSheet = TestCaseArray(3)
				  strTestCasePriority = TestCaseArray(4)
				  strTestCaseDescription = TestCaseArray(5)
				  ' import  test case table from abs xls to data table
                  Set TestStepArrays = CreateObject("Scripting.Dictionary")
                  strTestDataFolder =  Environment.Value("TestDataFolder")'test data folder
				  strTestCaseTablePath = pathFind(strTestDataFolder,strTestCaseTable, "xls")''test case xls file abs path
                  strTestCaseInDataTable = "TestCase"
                  DataTable.AddSheet(strTestCaseInDataTable)
				  On error Resume Next
                  DataTable.ImportSheet strTestCaseTablePath,1, strTestCaseInDataTable 'import excel file may cause error , so use On Error Resume Next
                   If   not Err.Number = 0  Then
				      msgbox "Check" & strTestCaseTablePath & " if it is opened already. Or check the column name is correct in xls" & "--Error Code:" & err.number
                  else

				 '   package test case table in DataTable to objTestTaks
				 Dim intRowCount, i
				 Dim strTestStepIDX, strTestStepBizName, strTestStepName, strTestStepBizDataTable, strTestStepFilter, strTestStepDescription
				 Dim TestStepArray(5) ' TestTaskArray(1) = BizName, 
                  intRowCount = DataTable.GetSheet(strTestCaseInDataTable).GetRowCount
                  For i = 1 To intRowCount-1
                      DataTable.GetSheet(strTestCaseInDataTable).SetCurrentRow(i)
                      strTestStepIDX = DataTable.Value("IDX", strTestCaseInDataTable)
                      If strTestStepIDX = "√"  Then               
							 strTestStepIDX     		   = DataTable.Value("IDX", strTestCaseInDataTable)
							 strTestStepBizName 		 = DataTable.Value("bizName", strTestCaseInDataTable)
							 strTestStepName			    = DataTable.Value("stepName", strTestCaseInDataTable)
							 strTestStepBizDataTable = DataTable.Value("bizDataTable", strTestCaseInDataTable)
							 strTestStepFilter 					 = DataTable.Value("filter", strTestCaseInDataTable)
							 strTestStepDescription 	 = DataTable.Value("description", strTestCaseInDataTable)

							TestStepArray(0) = strTestStepIDX
							TestStepArray(1) = strTestStepBizName
							TestStepArray(2) = strTestStepName
							TestStepArray(3) = strTestStepBizDataTable
							TestStepArray(4) = strTestStepFilter
							TestStepArray(5) = strTestStepDescription

							 TestStepArrays.Add strTestStepName, TestStepArray
							 If    not err.number = 0 Then
								 msgbox "Check column'IDX, bizName, description' is correct in "& strTestCaseTablePath&"--Error Code:"&err.number
								 Err.Clear
							 End If
					End If 	  
                 Next
			  End IF
			  On error Goto 0
 End Function

Public  Function StartTestCase(TestCaseArray)
              InitialTestCase TestCaseArray
			  StartTestCaseLog()

			  Dim i
			  Dim objTestStep
			  Dim TempTestStepArrays, TestStepArray
              For i = 0 To TestStepArrays.Count-1
                  Set objTestStep = new TestStep
                  TempTestStepArrays = TestStepArrays.Items
                  TestStepArray =TempTestStepArrays(i)
				  objTestStep.StartTestStep(TestStepArray)
				  Set objTestStep = nothing
              Next    

			  EndTestCaseLog()
End Function

Private Function StartTestCaseLog()
		 xmlLogPrint "<TestCase-"& strTestCaseName &">"
End Function

Private Function EndTestCaseLog()
		xmlLogPrint  "<" & "/TestCase-" & strTestCaseName &">"
End Function
		      
End Class


'=============================================================================================
'TestTask Class 
'============================================================================================== 
Class TestStep

Private strTestStepIDX 'IDX
Private strTestStepBizName 'bizName
Private	strTestStepName 'taskName
Private strTestStepBizDataTable ' bizDataTable
Private strTestStepFilter ' filter
Private strTestStepDescription ' description


Public Function StartTestStep(TestStepArray)
				  InitialTestStep TestStepArray 
				  StartTestStepLog()
				  
				  Dim strTestStepClass,  strTestStepClassPath
				  Dim  objTestScript
				  strTestStepClass = strTestStepBizName
				  Environment("bResult") = "Pass"  'default result is pass for each step
				  Set objTestScript = CreateObject("Scripting.Dictionary")
				  If Not objTestScript.Exists (strTestStepClass)  then 
						   strTestStepClassPath = pathFind(Environment.Value("TestScriptFolder"),strTestStepClass,"vbs")
							On Error Resume Next
							ExecuteFile strTestStepClassPath   'executefile  load external vbs file. only used in qtp
							If Err.Number = 0Then
								objTestScript.add strTestStepClass, strTestStepClassPath
								Dim strExecute 
								strExecute = "Set obj" & strTestStepClass & " = new " & strTestStepClass
								Execute strExecute
								If  not Err.Number = 0 Then
									   msgbox "Check" & strTestStepClassPath &"is Exsit" & "--Error Code:" & err.number
									   Err.Clear
								End If
							Else
								 msgbox "Check" & strTestStepClassPath &"is Exsit" & "--Error Code:" & err.number
								 err.Clear
						 End If   
						 On Error Goto 0
				 End If		
					strExecute = "Call obj" & strTestStepClass & "." & strTestStepName & "()"
					On error resume Next
					 Execute strExecute
					 If  not err.number = 0 Then
						Environment("bResult") = "Fail"
					 End If
					On error Goto 0
				'计算成功和失败的用例数
				If   Environment("bResult") = "Pass" Then
					   Environment("numPassed") =  Environment("numPassed") +1
				 else 
						Environment("numFailed") =  Environment("numFailed")+1
				End If
				Environment("bResult") = "Pass"

				EndTestStepLog()
End Function		     

Private Function InitialTestStep(TestStepArray)
			 strTestStepIDX = TestStepArray(0)
			 strTestStepBizName = TestStepArray(1)
			 strTestStepName = TestStepArray(2)
			 strTestStepBizDataTable = TestStepArray(3)
			 strTestStepFilter = TestStepArray(4)
			 strTestStepDescription = TestStepArray(5)
End Function

Function StartTestStepLog()
		Dim fso, xmlfile
		Set fso = CreateObject("Scripting.FileSystemObject")
		Set xmlfile = fso.OpenTextFile(Environment("LogDir")&"\runtime.xml", 8, True)
		xmlfile.WriteLine "<TestStep-" & strTestStepName& ">"
		xmlfile.Close
		Set xmlfile = nothing
		Set fso = Nothing
End Function

Function EndTestStepLog()
		Dim fso, xmlfile
		Set fso = CreateObject("Scripting.FileSystemObject")
		Set xmlfile = fso.OpenTextFile(Environment("LogDir")&"\runtime.xml", 8, True)
		xmlfile.WriteLine Environment("bResult")
		xmlfile.WriteLine "</TestStep-" & strTestStepName& ">"
		xmlfile.Close
		Set xmlfile = nothing
		Set fso = Nothing
End Function

End Class


'=============================================================================================
'Log ..................
'============================================================================================== 
Public Function xmlLogPrint(ByVal logMessage)
		Dim fso, xmlfile
		Set fso = CreateObject("Scripting.FileSystemObject")
		Set xmlfile = fso.OpenTextFile(Environment("LogDir")&"\" & "runtime.xml",8,True) 
		xmlfile.WriteLine logMessage
		xmlfile.Close
		Set xmlfile = nothing
		Set fso = nothing
End Function



'=============================================================================================
'framework util
'============================================================================================== 
Function pathFind( searchingFolder,searchingFileName,fileType)
'根据传入的根目录，查找该目录下的指定名称,以及指定文件类型的文件，并返回其绝对路径。
	Dim tempArray, fileName, i, searchedFilePath
	Dim fso,objFolder, objFileCollection, objFile
	tempArray = Split(searchingFileName,".")
	fileName = tempArray(0)&"."&fileType
	Set fso=CreateObject( "Scripting.FileSystemObject" )
	Set objFolder = fso.GetFolder( searchingFolder )
	Set objFileCollection = objFolder.Files
	for each objFile in objFileCollection
		If objFile.Name = fileName Then
			i=i+1
			searchedFilePath = objFile.Path
			Exit for
		End If
	Next

	Dim objSubFoldersCollection, objInputSubFolder
	If i=0 then
		'遍历子文件夹
		Set objSubFoldersCollection = objFolder.SubFolders
		For each objInputSubFolder in objSubFoldersCollection
			searchedFilePath= pathFind(objInputSubFolder,searchingFileName,fileType)
			If searchedFilePath<>"" Then 
				Exit For
			End if
		Next
	End If 
	pathFind = searchedFilePath
End Function



























































































































